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-- ListBcd.Mesa Edited by Sandman on April 13, 1978 3:38 PM 

DIRECTORY 

AUoDefs: FROM "altodefs", 
BcdDefs: FROM "boddefs", 
CommanderOef s : FROM "commanderdef s" , 
ControlDefs: FROM "controldef s" , 
lODefs: FROM "iodefs", 
ListerDefs: FROM "1 isterdef s" , 
OutputDefs: FROM "outputdef s" , 
SegmentDefs: FROM "segmentdef s" , 
StringDefs: FROM "stringdef s" . 
SymDefs: FROM "symdefs"; 

DEFINITIONS FROM OutputDefs, BcdDefs; 

ListBcd: PROGRAM 

IMPORTS CommanderDefs, lODefs, ListerDefs, OutputDefs. SegmentDefs, StringDefs 

EXPORTS ListerDefs = 

BEGIN 

bed: POINTER TO BCD; 

tb: CARDINAL; 

ssb: BcdDefs .NameString; 

Ctb: CARDINAL; 

mtb: CARDINAL; 

itb: CARDINAL; 

etb: CARDINAL; 

sgb: CARDINAL; 

ftb: CARDINAL; 

ntb: CARDINAL; 

InstallBcd: PROCEDURE [seg: SegmentDefs . FileSegmentHandle] = 
BEGIN OPEN SegmentDefs; 
size: CARDINAL; 

IF '-seg.swappedin THEN Swapln[seg]; 
bed ♦- Fi1eSegmentAddress[seg] ; 
IF (size^bcd.nPages) # seg. pages THEN 

BEGIN 

Un1ock[seg] ; 

MoveFileSegment[seg, seg. base, size]; 

Swapln[seg]; 

bed <- Fi1eSegmentAddress[seg]; 

END; 
tb *- LOOPHOLE[bcd]; 
ssb ^ LOOPHOLE[bed+bed.ssOffset]; 
ctb *- tb+bed.ctOffset; 
mtb <- tb+bed.mtOffset; 
itb ^ tb+bcd. impOffset; 
etb ^ tb+bcd. expOffset; 
sgb <- tb+bcd. sgOffset; 
ftb ^ tb+bcd. ftOffset; 
ntb <- tb+bcd. ntOffset; 
RETURN 
END; 

UnstallBcd: PROCEDURE [seg: SegmentDefs . FileSegmentHandle] = 
BEGIN OPEN SegmentDefs; 
IF seg. swappedin THEN Unlock[seg]; 
SwapOut[seg]; 
RETURN 
END; 

WriteBcdID: PROCEDURE [name: STRING, bed: POINTER TO BCD] = 
BEGIN 

PulString[name]; 
PutString[" configured "]; 
PutTime[bed. version. time]; 
IF bed. source ft NullName THEN 

BEGIN 

PutString[" from "]; 

PutName[bcd . source] ; 

END; 
PutString[" by "]; 

ListerDefs . PrintMachine[bcd .version] ; 
IF bed. versionident # VersionID THEN 
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BEGIN PutString[" Obsolete VersionID 
Pu tDec ima 1[ bed. versioni dent] END; 

PutCR[]; 

PutString[" Configured by "]; 

Pu tT ime[ b c d. creator. time]; 

PutString[" "]; 

ListerDef s .PrintMachine[bcd .creator] ; 

PutCR[]; PutCR[]; 

RETURN 

END; 



']; 



PrintBcd: PUBLIC PROCEDURE = 
BEGIN 

PrintHeader[]; PrintConf igs[]; 

PrintImports[] ; PrintExportsf]; 

PrintModules[] ; PrintFiles[] ; 
RETURN 
END; 



PrintHeader: 
BEGIN 

PutStringC 
PutString[ 
PutStringi 
PutString[ 
PutString[ 
PutString[ 
PutCR[]; 
RETURN 
END; 



PUBLIC PROCEDURE « 

'Configurations: "]; PutDecimal [bed .nConf igs]; 

Modules: "]; PutDecimal [bed .nModules] ; 

Imports: "]; PutDecimal [bed .nimports] ; 

Exports: "]; PutDecimal [bed . nExports] ; 

Dummy: "]; PutDecimal[bed . f irstdummy] ; 

i^Dummies: "]; PutDecimal [bed . nDummies] ; 
PutCR[]; 



PrintConfigs: PUBLIC PROCEDURE » 
BEGIN 

eti: CTIndex ^ FIRST[CTIndex]; 
PutString[" Configurations"]; 
PrintIndex[bcd.etOffset]; 
PutChar[' :]; PutCR[]; 
UNTIL eti = bed.etLimit DO 

PrintConf ig[cti]; 

eti ♦- eti + SIZE[CTReeord]; 

IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bed . ctLimit , CARDINAL] THEN GO TO Bogus; 

REPEAT Bogus => Pr intGarbage[] ; 

ENDLOOP; 
PutCR[]; 
RETURN 
END; 

PrintConf ig: PUBLIC PROCEDURE [eti: CTIndex] « 
BEGIN OPEN etb+cti; 
Tab[2]; 

PutName[name] ; Printlndex[eti] ; 
IF namedinstanee THEN 

BEGIN 

PutString[", instance: "]; 

PutInstanceName[[eonf ig[eti]]]; 

END; 
PutString['\ file: "]; 
PrintFileName[file]; Printlndex[f ile] ; 
IF eonfig j^ CTNull THEN 

BEGIN PutString['\ parent: "]; 

PutName[( ctb+config). name]; 

PrintIndex[eonf ig]; 

END; 
IF control ff MTNull THEN 

BEGIN PutString[", control: "]; 

PutName[(mbb+control ) .name]; 

Printlndex[ control ]; 

END; 
PutCR[]; 
RETURN 
END; 



Printlmports: PUBLIC PROCEDURE »- 
BEGIN 

iti: IMPIndex <- FIRST[IMPIndex] ; 
PutStr1ng["Imports"]; 
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Printlnclex[bcd. impOffset]; 
PutChar[' :]; PutCR[]; 
UNTIL iti =» bcd.impLinnt DO 

PrintImport[iti] ; 

iti <- iti + SIZF-:[IMPRecord]; 

IF LOOPHOLE[iti, CARDINAL] > LOOPflOLE[bcd . impLirn i L .CARDINAL] THEN GO TO Bogus; 

REPEAT Bogus => PrintGarbage[] ; 

ENDLOOP; 
PutCR[]; 
RETURN 
END; 

Printlmport: PUBLIC PROCEDURE [iti: IMPIndex] » 
BEGIN OPEN itb+iti; 
Tab[2]; 

Put Name [name] ; Printlndex[iti]; 
IF port = module THEN PutString[" (module)"]; 
IF namedinstance THEN 

BEGIN 

PutString[", instance: "]; 

PutInstanceName[[import[iti]]]; 

END; 
PutString[", file: "]; 
PrintFi1eName[f ile] ; Printlndex[file]; 
PutString[", gfi: "]; 
PutDecimal [gfi]; 
PutString[", ngfi: "]; 
PutDecimal [ngfi]; 
PutCR[]; 
RETURN 
END; 

PrintExports: PUBLIC PROCEDURE = 
BEGIN 

eti: EXPIndex *- FIRST[EXPIndex] ; 
PutString["Exports"]; 
PrintIndex[bcd.expOffset]; 
PutChar[' :]; PutCR[]; 
UNTIL eti = bcd.expLimit DO 

PrintExport[eti]; 

eti *- eti + (etb+eti) . size + SIZE[EXPRecord]; 

IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd . expLimit .CARDINAL] THEN GO TO Bogus; 

REPEAT Bogus => PrintGarbage[] ; 

ENDLOOP; 
PutCR[]; 
RETURN 
END; 

PrintExport: PUBLIC PROCEDURE [eti: EXPIndex] = 
BEGIN OPEN etb+eti ; 
i: CARDINAL; Tab[2]; 
Put Name [name] ; Printlndex[eti]; 
IF port = module THEN PutString[" (module)"]; 
IF namedinstance THEN 

BEGIN 

PutString[", instance: "]; 

PutInstanceName[[export[eti]]]; 

END; 
PutString[". file: "]; 
PrintFileName[f ile] ; Printlndex[fil8]; 
PutString[", size: "]; 
PutDecimal[size]; 
IF DumpLinks THEN 

BEGIN 

PutString[", links:"]; 

FOR i IN [0. .size) DO 

IF i MOD 8 « THEN Tab[4] ELSE PutChar[' ]; 

PrintControlLink[links[i]]; 

IF i+1 U size THEN PutChar[',]; 

ENDLOOP; 

END; 
PutCR[]; 
RETURN 
END; 

PrintModules: PUBLIC PROCEDURE « 
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BEGIN 

mti: MTIndex *- FIRST[MTIndex] ; 

PutString["Modules"]; 

PrintIndex[bcd.mtOffset]; 

PutChar[' :]; PutCR[]; 

mni mti « bcd.mtLimit DO 

PrintModu1e[mti]; 

mti <~ mti + SIZE[MTRecord] + (mtb+mti) .frame, length ; 

IF L00PHOLE[mti. CARDINAL] > LOOPHOLE[bcd .mtLimit . CARDINAL] THEN GO TO Bogus; 

REPEAT Bogus => PrintGarbage[] ; 

ENDLOOP; 
PutCR[]; 
RETURN 
END; 

PrintModule: PUBLIC PROCEDURE [mti: MTIndex] = 
BEGIN OPEN mtb+mti; 
i: CARDINAL; Tab[2]; 
PutName[name]; Printlndex[mti] ; 
IF namedinstance THEN 

BEGIN 

PutString["instance: "]; 

PutInstanceName[[module[mti]]]; 

END; 
PutString[". file: "]; 
Prin tFi1eName[f ile] ; Printlndex[file]; 
PutString[". links: "]; 

PutString[IF 1inks=frame THEN "frame" ELSE "code"]; 
IF config ff CTNull THEN 

BEGIN 

PutString[", config: "]; 

PutName[(ctb+conf ig) .name] ; 

PrintIndex[conf ig] ; 

END; 
Tab[4]; 

PutString["fsi : "]; PutDecimal[f si] ; 
PutString[", framesize: "]; PutDecimal[f ramesize] ; 
PutString[", gfi: "]; PutDecimal[gf i] ; 
PutString[", ngfi: "]; PutDecimal [ngf i] ; 
Tab[4]; 

PutString["code: "]; PrintSegment[code . sgi] ; 
PutString[", offset: "]; PutOctal [code .of f set] ; 
PutString[", length: "]; PutOctal [code . length] ; 
IF code. 1 inkspace THEN PutString [", link space"]; 
IF code. packed THEN PutString [", packed"]; 
Tab[4]; 

PutString["symbols : "]; PrintSegment[sseg] ; 
BEGIN OPEN frame; Tab[4]; 

PutString["f rame length: "]; PutDecimal [length] ; 

IF DumpLinks THEN 
BEGIN 

PutString[", control links:"]; 
FOR i IN [0. .length) DO 

IF i MOD 8 = THEN Tab[6] ELSE PutChar[' ]; 
PrintControlLink[frag[i]]; 
IF i + 1 ff length THEN PutChar['J; 
ENDLOOP; 
END; 

END; 
PutCR[]; 
RETURN 
END; 

PrintSegment: PUBLIC PROCEDURE [sgi: SGIndex] « 
BEGIN OPEN sd: sgb+sgi; 

PrintFileName[sd.f ile]: PutString[" [base: "]; 
PutDecimal [sd. base] ; PutString[", pages: "]; 
PutDecimal [sd. pages]; 
IF sd.extraPages // THEN 

BEGIN PutChar['f]; PutDecimal [sd .extraPages] ; END; 
PutChar[']]; 
RETURN 
END; 

PrintFiles: PUBLIC PROCEDURE « 
BEGIN 
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fti: FTIndex <- FIRST[FTIndex] ; 
PutString["Files"]; 
PrintIndex[bcd,ftOffset]; 
PutChar[' :]; PutCR[3; 
UNTIL fti ^ bcd.ftLimit DO 

PrintF-ne[fti]: 

fti <- fti + SIZE[FTRecord]; 

IF LOOPHOLE[fti, CARDINAL] > LOOPHOLE[bcd . ftLimit .CARDINAL] THEN GO TO Bogus; 

REPEAT Bogus «> PrintGarbage[] ; 

ENDLOOP; 
PutCR[]; 
RETURN 
END; 

PrintFile: PUBLIC PROCEDURE [fti: FTIndex] « 
BEGIN OPEN ftb+fti; 
Tab[2]; 
SELECT fti FROM 

FTNun => PutString["(null)"]; 
FTSelf => PutString["(se1f)"]; 
ENDCASE =«> 
BEGIN 

PutName[name]; Printlndex[f ti] ; 
PutString[", time: "]; 
Pu tT i me [ vers ion. time] ; 
PutString[", processor: "]; 
ListerDef s .PrintMachine[version] ; 
END; 
PutCR[]; 
RETURN 
END; 

-- Utility Prints 

PrintControlLink: PROCEDURE [link: ControlLink] = 
BEGIN 
map: ARRAY ControlLinkTag OF CHARACTER = [ ' » ' 1 , ' 2 . '3] ; 



PutChar['[] 
PutChar[* ,] 
PutChar[* ,] 
PutChar[']] 
END; 



PutDecima1[l ink.gf i]; 
PutDecimal[1 ink .ep]; 
PutChar[map[1ink. tag]]; 
RETURN 



PrintFileName: PROCEDURE [fti: FTIndex] = 
BEGIN 
SELECT fti FROM 

FTNull => PutString["(nun)"]; 

FTSelf => PutString["{self)"]; 

ENDCASE => PutName[(ftb+rti).name]; 
RETURN 
END; 

Printlndex: PROCEDURE [index: UNSPECIFIED] = 
BEGIN 

PutString[" [*']; PutDecimal [index] ; 
PutChar[']]; RETURN 
END; 

PrintGarbage: PROCEDURE » 
BEGIN Tab[2]; 

PutString["? looks like garbage to me ..."]; 
PutCR[]; RETURN 
END; 

PrintAnonName: PROCEDURE = 
BEGIN 

PutString[" (anon) "]; 
RETURN 
END; 



-- Utility Puts 

PutName: PUBLIC PROCEDURE [n: NameRecord] 
BEGIN 
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ssd: StringDefs.SubStringDescriptor <~ [ 

base: @ssb. string, offset: n, length: MIN[ssb . size[n] , 100]] ; 
PutSubString[6sscl]; 
RETURN 
END; 

Tab: PROCEDURE [n: CARDINAL] - 
BEGIN 

ListerDefs,Indent[n]; 
RETURN 
END; 

PutlnstanceName: PROCEDURE [n: Namee] » 
BEGIN 
FindName: PROCEDURE [ntb: CARDINAL, nti: NTIndex] RETURNS [BOOLEAN] « 

BEGIN 

RETURN[(ntb+nti).item = n]; 

END; 
nti: NTIndex; 
IF (nti *- EnumerateNameTable[FindNanie]) = NTNull 

THEN PrintAnonName[] 

ELSE PutName[(ntb+nti).name]; 
END; 

EnumerateNameTable: PROCEDURE [ 
proc: PROCEDURE [CARDINAL, NTIndex] RETURNS [BOOLEAN]] 
RETURNS [nti: NTIndex] = 
BEGIN 

FOR nti ^ FIRST[NTIndex], nti + SIZE[NTRecord] DO 
IF proc[ntb, nti] THEN RETURN [nti]; 
ENDLOOP; 
RETURN [NTNull]; 
END; 

-- IncorrectVersion: EXTERNAL SIGNAL; 

Bed: PROCEDURE [root: STRING] = 
BEGIN 

i: CARDINAL; 
bcdfile: STRING ^ [40]; 
seg: SegmentDef s , FileSegmen than die; 
BEGIN OPEN StringDefs; 

AppendString[bcdfile.root]; 
FOR i IN [0. .bcdfile. length) DO 
IF bcdfile[i] = ' . THEN EXIT; 

REPEAT FINISHED => AppendStri ng[bcdf i 1 e . " . bed"] ; 
ENDLOOP; 
END; 
BEGIN OPEN SegmentDef s; 
seg *- NewFileSegment[ 

NewFile[bcdf ile, Read, Def aul tVersion I 

FileNameError => GO TO NoFile], 
1, 1, Read]; 
InstallBcd[seg] ; 
OpenOutput[root,".bl"]; 
WriteBcdID[bcdfile,bcd]; 
PrintBcd[]; CloseOutput[] ; 
Uns tallBcd[seg] ; 
EXITS 

NoFile => IODefs.WriteString["File not found"]; 
END; } 

RETURN 
END; 

BcdLinks: PROCEDURE [root: STRING] = 
BEGIN 

DumpLinks <~ TRUE; 
Bcd[root] ; 
DumpLinks *- FALSE; 
RETURN 
END; 

BcdSegment: PROCEDURE [ 
root: STRING, base: Al toDef s . PageNumber , pages: AltoDef s .PageCount, links: BOOLEAN] 
BEGIN 
i: CARDINAL; 
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bcdfile: STRING <- [40]; 

seg: SegmentDef s . FileSegmentHandle; 

DumpLinks <- links; 

BEGIN OPEN StringDefs; 

AppendString[bcdf ile, root]; 
FOR i IN [0. .bcdfile. length) DO 
IF bcdfile[i] « • . THEN EXIT; 

REPEAT FINISHED «> AppendString[bcdf i1 e , " .bed"] ; 
ENDLOOP; 
END; 
BEGIN OPEN SegmentDefs; 
seg <- NewFileSegmenti 

NewFi1e[bcdf ile, Read, Defaul tVersion I 

FileNameError »> GO TO NoFile], 
base, pages, Read 1 

Inval idSegmentSize «> GO TO BadSegment]; 
InstanBcd[seg I SwapError, SegmentFaul t => GO TO BadSegment]; 
OpenOutput[root,".br']; 
WriteBcdID[bcdfile,bcd]; 
PrintBcd[]; CloseOutput[] ; 
Unstal 1Bcd[seg] ; 
EXITS 

NoFile => I0Defs.WriteString["Fi1e not found"]; 
BadSegment => lODef s .WriteString["Bad Segment"]; 
END; 
DumpLinks <- FALSE; 
END; 



DumpLinks: BOOLEAN ^ FALSE; 

command: Commander Defs .CommandBlockHandle; 

command *- CommanderDef s . AddCommand["Bcd" , LOOPHOLE[Bcd] , 1]; 
command. params[0] ^ [type: string, prompt: "Filename"]; 

command *- CommanderDef s .AddCommand["BcdLinks" , LOOPHOLE[BcdLinks] , 1]; 
command. params[0] *- [type: string, prompt: "Filename"]; 

command «- CommanderDef s .AddCommand["BcdSegment" , LOOPHOLE[BcdSegment] , 4]; 



command . params[0] <- [type 

command. params[l] *- [type 

command. params[2] <- [type 

command. params[3] ^ [type 



string, prompt: "Filename"]; 
numeric, prompt: "Base"]; 
numeric, prompt: "Pages"]; 
boolean, prompt: "Links"]; 



END 



